﻿Imports System.Net.Sockets
Imports System.Net

Public Class FrmTCPRelay

#Region "本地客户端定义"
    Private mLocalClient As Socket '本地客户端
    Private mLocalClientConnect As Boolean
    Private mLocalClientEvn As SocketAsyncEventArgs
#End Region


    Private mServerSocket As Socket '本地服务器
    Private mClientList As List(Of Socket) '远程连接来的客户端

    Private Sub FrmTCPRelay_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        mClientList = New List(Of Socket)(20)

        mServerSocket = Nothing
        mLocalClientConnect = False

        ShowClientCount()

        '托盘图标
        IniNotifyIcon()


        butConnect_Click(Nothing, Nothing)
        ButListener_Click(Nothing, Nothing)
    End Sub


#Region "托盘图标"
    Private Sub IniNotifyIcon()
        NIco.Icon = Icon
        Dim oMI(1) As MenuItem
        oMI(0) = New MenuItem("显示窗口")
        oMI(1) = New MenuItem("隐藏窗口")

        For i = 0 To 1
            AddHandler oMI(i).Click, AddressOf NotifyMenu_Click
        Next

        NIco.ContextMenu=new ContextMenu(oMI)

    End Sub


    Private Sub NotifyMenu_Click(ByVal sender As System.Object, ByVal e As System.EventArgs)
        Dim oMenu As MenuItem = sender
        Select Case oMenu.Text
            Case "显示窗口"
                Visible = True
                WindowState = FormWindowState.Normal
                Show()
            Case "隐藏窗口"
                Visible = False
        End Select
    End Sub

    Private Sub FrmTCPRelay_Resize(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Resize
        If WindowState = FormWindowState.Minimized Then Visible = False

    End Sub

#End Region

#Region "本地客户端操作"

    Private Class AddrInfo
        Public Addr As String
        Public Port As UInt16
        Public IsClose As Boolean
    End Class

    Private Sub butConnect_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles butConnect.Click
        If Not mLocalClientConnect Then
            Dim sServerAddr As String = TxtServer.Text.Trim()
            If String.IsNullOrEmpty(sServerAddr) Then
                MsgBox("请输入服务器的IP地址！", 64, "提示")
                Return
            End If

            Dim iPort As UInt32
            If Not UInt32.TryParse(TxtServerPort.Text, iPort) Then
                MsgBox("请输入正确的端口号！(1-65535)", 64, "提示")
                Return
            End If
            If iPort < 1 Or iPort > 65535 Then
                MsgBox("请输入正确的端口号！(1-65535)", 64, "提示")
                Return
            End If

            SetbutConnectText("关闭连接", Color.Blue)
            Dim oAddr As AddrInfo = New AddrInfo
            oAddr.Addr = sServerAddr
            oAddr.Port = iPort

            If mLocalClient Is Nothing Then
                mLocalClient = New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)
            End If
            mLocalClientConnect = True

            '首先开始解析DNS
            mDNSResult = Dns.BeginGetHostEntry(sServerAddr, New AsyncCallback(AddressOf DNSHostCallback), oAddr)
            SetText("开始域名解析：" & sServerAddr)
        Else


            LocalClientClose()
            SetText("本地服务器--用户终止连接！")
        End If
    End Sub

#Region "DNS域名解析"
    Private mDNSResult As IAsyncResult

    ''' <summary>
    ''' 接收DNS解析
    ''' </summary>
    ''' <param name="ar"></param>
    ''' <remarks></remarks>
    Private Sub DNSHostCallback(ByVal ar As IAsyncResult)
        Dim oAddr As AddrInfo = ar.AsyncState
        If oAddr.IsClose Then
            SetText("域名解析已被用户终止！" & oAddr.Addr)
            Return
        End If


        mDNSResult = Nothing
        Dim oIP As IPAddress = Nothing
        Dim oServerDNSInfo As IPHostEntry

        Try
            oServerDNSInfo = Dns.EndGetHostEntry(ar)
            If oServerDNSInfo.AddressList.Length > 0 Then
                '获取服务器节点
                oIP = oServerDNSInfo.AddressList(0)
            End If

        Catch scErr As SocketException
            Select Case scErr.ErrorCode
                Case 11004
                    Try
                        oIP = IPAddress.Parse(oAddr.Addr)
                    Catch ex1 As Exception
                        SetText("域名解析失败！" & ex1.Message)
                        LocalClientClose()
                        Return
                    End Try
                Case 11001
                    SetText("域名解析失败！" & scErr.Message)
                    LocalClientClose()
                    Return
                Case Else
                    SetText("未知错误！" & scErr.Message)
                    LocalClientClose()
                    Return
            End Select
        Catch ex As Exception
            SetText("未知错误！" & ex.Message)
            LocalClientClose()
            Return
        End Try

        SetText(String.Format("域名解析完毕: {0} -- {1}", oAddr.Addr, oIP.ToString()))

        '启动网络连接
        Dim remoteEP As IPEndPoint = New IPEndPoint(oIP, oAddr.Port)

        mLocalClientEvn = New SocketAsyncEventArgs
        AddHandler mLocalClientEvn.Completed, AddressOf LocalClientConnectCompleted
        mLocalClientEvn.RemoteEndPoint = remoteEP


        mLocalClient.ConnectAsync(mLocalClientEvn)
        SetText(String.Format("正在连接服务器({0}){1}:{2}... ...", oAddr.Addr, oIP.ToString, oAddr.Port))
    End Sub
#End Region

#Region "设置本地服务器连接按钮文字"
    Delegate Sub SetbutConnectTextCallback(ByVal sText As String, ByVal iColor As Color)


    ''' <summary>
    ''' 设置本地服务器连接按钮文字
    ''' </summary>\
    ''' <remarks></remarks>
    Private Sub SetbutConnectText(ByVal sText As String, ByVal iColor As Color)
        If Me.butConnect.InvokeRequired Then
            Dim d As New SetbutConnectTextCallback(AddressOf SetbutConnectText)
            Me.Invoke(d, New Object() {sText, iColor})
        Else
            Me.butConnect.Text = sText
            Me.butConnect.ForeColor = iColor
        End If

    End Sub
#End Region



    ''' <summary>
    ''' 关闭远程服务器连接
    ''' </summary>
    ''' <remarks></remarks>
    Private Sub LocalClientClose()

        If mDNSResult IsNot Nothing Then
            Dim oAddr As AddrInfo = mDNSResult.AsyncState
            oAddr.IsClose = True
            oAddr = Nothing

            mDNSResult = Nothing

        End If

        If mLocalClient Is Nothing Then Return
        If Not mLocalClientConnect Then Return

        If mLocalClient.Connected Then
            mLocalClient.Shutdown(SocketShutdown.Both)
        End If

        mLocalClient.Close
        mLocalClient = Nothing

        mLocalClientConnect = False

        mLocalClientEvn = Nothing

        SetbutConnectText("连接服务器", Color.Black)
    End Sub


    ''' <summary>
    ''' 连接服务器完毕的回调函数
    ''' </summary>
    ''' <param name="sender"></param>
    ''' <param name="e"></param>
    ''' <remarks></remarks>
    Private Sub LocalClientConnectCompleted(ByVal sender As Object, ByVal e As System.Net.Sockets.SocketAsyncEventArgs)
        Select Case e.LastOperation
            Case SocketAsyncOperation.Connect
                Select Case e.SocketError
                    Case SocketError.Success
                        SetText("服务器连接成功！")

                        If e.Buffer() Is Nothing Then
                            Dim bBuf(1024 * 8) As Byte
                            e.SetBuffer(bBuf, 0, bBuf.Length)
                        End If
                        e.UserToken = mLocalClient

                        RemoveHandler e.Completed, AddressOf LocalClientConnectCompleted
                        AddHandler e.Completed, AddressOf ReceiveCompleted

                        BeginReceive(e) '开始接收数据

                        Return
                    Case SocketError.TimedOut
                        SetText("服务器无响应，连接超时！")
                    Case SocketError.OperationAborted
                        SetText("用户终止连接！")
                    Case SocketError.ConnectionRefused
                        SetText("服务器拒绝连接！")
                    Case SocketError.AddressAlreadyInUse

                    Case Else
                        SetText("发送未知错误！" & e.SocketError.ToString())
                End Select

                LocalClientClose()

            Case Else

                Debug.Print("ConnectCompleted 返回异常值：" & e.LastOperation)
        End Select
    End Sub



#End Region


#Region "接收数据"

    ''' <summary>
    ''' 开始进入监听接收状态
    ''' </summary>
    ''' <remarks></remarks>
    Public Sub BeginReceive(ByVal e As SocketAsyncEventArgs)
        Dim oClientSocket As Socket = e.UserToken

        If oClientSocket Is Nothing Then Return

        Try
            If Not oClientSocket.ReceiveAsync(e) Then
                processReceived(e)
            End If
        Catch ex As Exception
            SetText("BeginReceive " & ex.ToString())
        End Try

    End Sub

    Public Sub ReceiveCompleted(ByVal sender As Object, ByVal e As System.Net.Sockets.SocketAsyncEventArgs)
        Select Case e.LastOperation
            Case SocketAsyncOperation.Receive
                processReceived(e)
            Case Else
                SetText("ReceiveCompleted" & e.LastOperation.ToString())
        End Select
    End Sub


    Private Sub processReceived(ByVal e As SocketAsyncEventArgs)
        Dim oClientSocket As Socket = e.UserToken

        Select Case e.SocketError
            Case SocketError.Success

                If e.BytesTransferred > 0 Then
                    Dim sTxt As String = String.Empty
                    Dim bBuf() As Byte
                    bBuf = copyOfRange(e.Buffer, 0, e.BytesTransferred) '获取接收缓冲区内容
                    Dim oIP As IPEndPoint = e.RemoteEndPoint
                    CheckReceived(oClientSocket, bBuf)
                ElseIf e.BytesTransferred = 0 Then

                    CloseClientOnEventarg(oClientSocket)
                    Return
                End If

            Case SocketError.OperationAborted

                CloseClientOnEventarg(oClientSocket)
                Return
            Case SocketError.ConnectionReset
                SetText("远程连接被重置！" & oClientSocket.RemoteEndPoint.ToString)
                CloseClientOnEventarg(oClientSocket)
                Return
        End Select

        BeginReceive(e)
    End Sub



    Private Sub CloseClientOnEventarg(ByVal oClient As Socket)

        If oClient.Equals(mLocalClient) Then
            SetText("本地服务器已关闭连接！")
            '连接关闭
            LocalClientClose()
        Else
            CloseClient(oClient)
        End If
    End Sub

    Private Sub CloseClient(ByVal oClient As Socket)
        If oClient Is Nothing Then Return
        Dim oIP As IPEndPoint

        'If oClient.Connected = False Then Return
        Try
            oIP = oClient.RemoteEndPoint
        Catch ex As ObjectDisposedException
            Return
        End Try


        SetText(String.Format("客户端连接断开({0}:{1})", oIP.Address.ToString(), oIP.Port))

        mClientList.Remove(oClient)
        DeleteClient(oClient)
        ShowClientCount()


        '关闭连接
        oClient.Shutdown(SocketShutdown.Both)
        oClient.Close()
        oClient = Nothing
    End Sub
#End Region

#Region "转发数据"


    ''' <summary>
    ''' 操作接收到的数据
    ''' </summary>
    ''' <param name="bData"></param>
    ''' <remarks></remarks>
    Private Sub CheckReceived(ByVal oClient As Socket, ByVal bData() As Byte)

        If oClient.Equals(mLocalClient) Then
            If ChkShowIO.Checked Then SetText("本地服务器--接收到数据准备转发，数据长度：" & bData.Length)
            If mServerSocket Is Nothing Then Return
            '开始转发到远程客户端
            For i As Integer = mClientList.Count - 1 To i Step -1
                If mClientList(i).Connected Then
                    '异步发送  
                    Try
                        mClientList(i).Send(bData)
                    Catch ex As SocketException
                        If ex.ErrorCode = 10054 Then
                            CloseClient(mClientList(i))
                        Else
                            SetText(String.Format("Send 发送数据时发生异常({0})：{1}", oClient.RemoteEndPoint.ToString(), ex.Message()))
                        End If
                    End Try
                Else
                    CloseClient(mClientList(i))
                End If
            Next
        Else


            '转发到本地服务器
            If mLocalClient Is Nothing Then Return
            If mLocalClient.Connected Then

                Try
                    If ChkShowIO.Checked Then SetText("远程客户端--接收到数据准备转发，数据长度：" & bData.Length)

                    mLocalClient.Send(bData)
                Catch ex As SocketException
                    SetText(String.Format("Send 发送数据时发生异常({0})：{1}", oClient.RemoteEndPoint.ToString(), ex.Message()))
                End Try
            End If
        End If
    End Sub

#End Region


#Region "服务器操作"

    Public Class SocketInfo
        Public Client As Socket

        Public Sub New(ByVal oClient As Socket)
            Client = oClient
        End Sub

        ''' <summary>
        ''' 输出远程连接端信息
        ''' </summary>
        ''' <returns></returns>
        ''' <remarks></remarks>
        Public Overrides Function toString() As String
            If Client Is Nothing Then
                Return "NULL"
            Else
                Return Client.RemoteEndPoint.ToString
            End If
        End Function
    End Class



#Region "显示客户端数量"
    ''' <summary> 设置已连接到服务器的客户端数量 </summary>
    Delegate Sub ShowClientCountCallback()
    ''' <summary> 设置已连接到服务器的客户端数量 </summary>
    Private Sub ShowClientCount()
        If Me.LblClientCount.InvokeRequired Then
            Dim callback As New ShowClientCountCallback(AddressOf ShowClientCount)
            Me.Invoke(callback)
            Return
        End If

        LblClientCount.Text = String.Format("已连接客户端数量：{0}", mClientList.Count)
    End Sub
#End Region

#Region "添加客户端列表"
    ''' <summary>
    ''' 添加客户端到列表
    ''' </summary>
    ''' <param name="oClient"></param>
    ''' <remarks></remarks>
    Delegate Sub AddClientCallback(ByRef oClient As Socket)

    ''' <summary>
    ''' 添加客户端到列表
    ''' </summary>
    ''' <param name="oClient"></param>
    ''' <remarks></remarks>
    Private Sub AddClient(ByRef oClient As Socket)
        If Me.CmbClient.InvokeRequired Then
            Dim callback As New AddClientCallback(AddressOf AddClient)
            Me.Invoke(callback, New Object() {oClient})
        Else
            Dim oSk As SocketInfo = New SocketInfo(oClient)
            SyncLock (CmbClient)
                CmbClient.Items.Add(oSk)
                CmbClient.SelectedItem = oSk
                ShowClientCount()
            End SyncLock
        End If
    End Sub
#End Region

#Region "删除客户端列表"

    ''' <summary> 从客户端列表中删除客户端信息 </summary>
    Delegate Sub DeleteClientCallback(ByRef oClient As Socket)
    ''' <summary> 从客户端列表中删除客户端信息 </summary>
    Private Sub DeleteClient(ByRef oClient As Socket)

        If Me.CmbClient.InvokeRequired Then
            Dim callback As New DeleteClientCallback(AddressOf DeleteClient)
            If oClient Is Nothing Then Return
            Me.Invoke(callback, New Object() {oClient})
        Else
            Dim i As Integer
            Dim oItem As SocketInfo
            Try
                SyncLock (CmbClient)
                    '从客户端列表删除
                    For i = 0 To Me.CmbClient.Items.Count - 1
                        oItem = CType(Me.CmbClient.Items(i), SocketInfo)
                        If oItem.Client.Equals(oClient) Then
                            CmbClient.Items.RemoveAt(i)
                            Return
                        End If
                    Next
                End SyncLock
            Catch ex As Exception
                SetText("DeleteClient -- 发生错误：" & ex.Message)
            End Try

        End If
    End Sub
#End Region


    Private Sub ButListener_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButListener.Click
        If mServerSocket Is Nothing Then
            Dim iPort As UInt32
            If Not UInt32.TryParse(TxtPort.Text, iPort) Then
                MsgBox("请输入正确的端口号！(1-65535)", 64, "提示")
                Return
            End If
            If iPort < 1 Or iPort > 65535 Then
                MsgBox("请输入正确的端口号！(1-65535)", 64, "提示")
                Return
            End If



            '获取本地监听信息
            Dim ipHostInfo As IPHostEntry = Dns.GetHostEntry(Dns.GetHostName()) '获取本机IP地址
            Dim oIP As IPAddress  '摘取本机IP地址
            Dim sIP As String = String.Empty
            For Each oIP In ipHostInfo.AddressList
                If Not oIP.IsIPv6LinkLocal Then
                    sIP += oIP.ToString & ","
                End If
            Next
            Dim localEndPoint As New IPEndPoint(IPAddress.Any, iPort) '创建一个绑定点

            '创建监听器
            mServerSocket = New Socket(AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp)


            Try
                '将监听器绑定到本地IP的指定端口上
                mServerSocket.Bind(localEndPoint)

                mServerSocket.Listen(100) '开始监听
            Catch ex As Exception
                mServerSocket.Close()
                mServerSocket = Nothing

                SetText("建立服务器监听时发生错误：" & ex.Message)
                Return
            End Try

            SetText("已启动服务监听，IP：" & sIP & "端口：" & iPort)

            Dim oEvent As SocketAsyncEventArgs = New SocketAsyncEventArgs
            AddHandler oEvent.Completed, AddressOf AcceptCompleted
            mServerSocket.AcceptAsync(oEvent)

            ButListener.Text = "关闭监听"
            ButListener.ForeColor = Color.Blue
        Else
            SetText("用户停止监听并断开所有客户端！")
            StopLiten()

            ButListener.Text = "开始监听"
            ButListener.ForeColor = Color.Black
        End If
    End Sub



#Region "等待连接请求"

    Private Sub BeginAccept(ByVal e As SocketAsyncEventArgs)
        If mServerSocket Is Nothing Then Return

        e.AcceptSocket = Nothing

        If Not mServerSocket.AcceptAsync(e) Then
            processAccept(e)
        End If
    End Sub

    Private Sub AcceptCompleted(ByVal sender As Object, ByVal e As System.Net.Sockets.SocketAsyncEventArgs)
        Select Case e.LastOperation
            Case SocketAsyncOperation.Accept
                processAccept(e)
            Case Else
                SetText("AcceptCompleted 返回异常值：" & e.LastOperation)
                StopLiten() '关闭连接
        End Select
    End Sub

    Private Sub processAccept(ByVal e As SocketAsyncEventArgs)
        If e.SocketError = SocketError.Success Then

            Dim oClientSocket As Socket
            '接收客户端请求。
            oClientSocket = e.AcceptSocket

            '加入集合
            mClientList.Add(oClientSocket)
            AddClient(oClientSocket)


            SetText("有客户端连接接入：" & oClientSocket.RemoteEndPoint.ToString)

            Dim readEventArgs As SocketAsyncEventArgs = New SocketAsyncEventArgs
            readEventArgs.UserToken = oClientSocket
            readEventArgs.RemoteEndPoint = oClientSocket.RemoteEndPoint
            AddHandler readEventArgs.Completed, AddressOf ReceiveCompleted
            Dim oBuff() As Byte
            ReDim oBuff(1024 * 8)
            readEventArgs.SetBuffer(oBuff, 0, oBuff.Length)
            '准备接收客户端消息
            BeginReceive(readEventArgs)
            '重新监听连接请求
            BeginAccept(e)
        End If
    End Sub
#End Region


    Public Sub StopLiten()
        mServerSocket.Close()
        mServerSocket = Nothing

        If mClientList.Count > 0 Then
            For i As Integer = mClientList.Count - 1 To 0 Step -1
                CloseClient(mClientList(i))
            Next
        End If
    End Sub


#End Region



#Region "窗口文本输出"
    ''' <summary>
    ''' 设置输出窗口文本的委托
    ''' </summary>
    ''' <param name="text"></param>
    ''' <remarks></remarks>
    Delegate Sub SetDebugTextCallback(ByVal [text] As String)

    ''' <summary>
    ''' 设置输出窗口文本
    ''' </summary>
    ''' <param name="text"></param>
    ''' <remarks></remarks>
    Private Sub SetText(ByVal [text] As String)
        If Me.TxtDebug.InvokeRequired Then
            Dim d As New SetDebugTextCallback(AddressOf SetText)
            Me.Invoke(d, New Object() {[text]})
        Else
            Me.TxtDebug.Text = Format(Date.Now, "HH:mm:ss") & "--" & [text] & vbNewLine & TxtDebug.Text

            If Me.TxtDebug.Text.Length > 6000 Then
                Me.TxtDebug.Text = Me.TxtDebug.Text.Substring(0, 3000)
            End If
        End If

    End Sub
#End Region


    Private Sub butClear_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles butClear.Click
        TxtDebug.Text = String.Empty
    End Sub

    Private Sub ButSend_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButSend.Click
        If CmbClient.SelectedItem Is Nothing Then
            MsgBox("请选择一个接收数据的客户端！", 64, "提示")
            Return
        End If
        If TxtSend.Text.Trim().Length = 0 Then
            MsgBox("请输入需要发送的内容！", 64, "提示")
            Return
        End If

        Dim oClient As SocketInfo = CType(CmbClient.SelectedItem, SocketInfo)
        Me.Send(oClient.Client, TxtSend.Text.Trim())
        'TxtSend.Text = String.Empty
    End Sub


    ''' <summary>
    ''' 往客户端发送数据
    ''' </summary>
    ''' <param name="oClient"></param>
    ''' <param name="data"></param>
    ''' <remarks></remarks>
    Private Sub Send(ByVal oClient As Socket, ByVal data As String)
        '转换明文为字节数组     
        Dim byteData As Byte() = {}
        If ChkHex.Checked = False Then
            byteData = gEncDefault.GetBytes(data)
        Else
            byteData = ModTool.HexToByte(data)
        End If



        '异步发送  
        Try
            oClient.Send(byteData)
        Catch ex As SocketException
            If ex.ErrorCode = 10054 Then
                CloseClient(oClient)
            Else
                SetText(String.Format("Send 发送数据时发生异常({0})：{1}", oClient.RemoteEndPoint.ToString(), ex.Message()))
            End If


        End Try

    End Sub 'Send    


End Class
